home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Plurals
/
mp_ciferio.m
< prev
next >
Wrap
Text File
|
1992-05-12
|
9KB
|
381 lines
/*
* MP_Lisp
*
* Author: S.C.Merrall
*
* File: mp_cifer.m
*
* Contents: encode
* decode
* fe_decode
* next_byte
*
* Description: These functions allow lisp objects to be easily
* moved between the front end and the backend, and
* between processing elements. A lisp structure is
* encoded into a character string which can be
* easily transferred, and then this is string is
* used as a description to build the object in the
* new location
*
* Change History:
*
* Date Name Comment
* -------- ---- -------
* 25:06:91 SCM Created - code copied from mp_print.m
*
*/
#include <mpl.h>
#include <stdio.h>
#include "constant.h"
#include "mp_object.h"
#include "mp_debug_off.h"
#include "mp_mem_mgmt.h"
#include "mp_gc.h"
#include "mp_type.h"
/*----------------------------------------------------------------------------*
* Function : encode
*
* Parameters : MP_PluralHeap MPPH_obj: Handle on things to be encoded
*
* Description: Encodes arbitrary lisp objects in to character strings in
* The processor scratch space. (Makes sure it fits the
* scratch space by giving up early if there isn't enough room!
* decode will interpret the missing stuff as nils.
*
* Result : int FAIL/SUCCESS
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int encode( MP_PluralHeap MPPH_obj );
#else
int encode( MPPH_obj )
MP_PluralHeap MPPH_obj;
#endif
{
plural natural *plural general_vector;
plural int size = MP_LENGTH(MP_CONS_SIZE);
int result_status = SUCCESS;
int i;
float real;
plural natural tmp;
MP_PluralHeap MPPH_tmp = &tmp;
DBG_CALL("encode");
DBG_ARGS(fprintf(dbg,"MPPH_obj = ????"));
if (scratch[0] >= (SCRATCH_MEMORY_SIZE - 4)) {
DBG_FAIL(fprintf(dbg,"FAIL: Exceeded scratch space"));
return FAIL;
}
if ((OA_offsets(MPPH_obj) == NIL) || (OA_offsets(MPPH_obj) == NOT_NIL)) {
scratch[scratch[0]++] = MP_SPECIAL;
scratch[scratch[0]++] = OA_offsets(MPPH_obj);
}
else {
scratch[scratch[0]++] = (plural char) OA_info(MPPH_obj);
switch (OA_info(MPPH_obj)) {
case MP_SYMBOL :
case INTEGER :
case MP_FLOAT :
for (i=0;i<sizeof(int);i++)
scratch[scratch[0]++]= *(OA_data(MPPH_obj)+i);
break;
case MP_VECTOR:
size = MP_LENGTH(OA_space(MPPH_obj));
scratch[scratch[0]++] = (plural char) size;
case MP_CONS :
general_vector = (plural natural *plural) OA_data(MPPH_obj);
for (i=0; (i<size) && (result_status != FAIL); i++) {
OA_offsets(MPPH_tmp) = general_vector[i];
result_status = encode(MPPH_tmp);
}
default :
result_status = FAIL;
}
}
/* if (result_status == FAIL) {
*
* DBG_FAIL(fprintf(dbg,"FAIL: Out of scratch space or unknown object"));
* return FAIL;
* }
*/
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}
/*----------------------------------------------------------------------------*
* Function : next_byte
*
* Parameters : void
*
* Description: In order to be able to use decode for objects encoded on
* the front end, it is necessary to read a description which
* could be more than SCRATCH_MEMORY_SIZE bytes long. Using
* next_byte rather than explicitly passing along the scratch
* space means that when we run out of description the next 64
* can be read.
* If scratch is empty, i.e. scratch[0] when first called then
* it is assumed a description is being read from the front
* end and it is read from there and a copyIn will be done
* to affect initialisation
*
* Result : char :the next byte
*---------------------------------------------------------------------------*/
plural int fe_des_length;
plural int fe_des_index;
char *fe_des;
#ifdef __STDC__
plural char next_byte( char *description )
#else
plural char next_byte( description )
char *description;
#endif
{
int i;
int integer = 1;
char *to_integer = (char *) &integer;
DBG_CALL("next_byte");
DBG_ARGS(fprintf(dbg,"decsription=%x",description));
if (description != NULL) {
fe_des = description;
if (copyIn(fe_des, acu_scratch, SCRATCH_MEMORY_SIZE) != 0) {
for (i=0; i<sizeof(int); i++) acu_scratch[i] = *(to_integer + i);
acu_scratch[sizeof(int)] = NULL;
DBG_FAIL(fprintf(dbg,"FAIL: Error loading initial segment"));
return (plural char) FAIL; /* Which is also the same as NULL => nil */
}
fe_des = fe_des + SCRATCH_MEMORY_SIZE;
sp_memcpy((plural char *plural) scratch, acu_scratch, SCRATCH_MEMORY_SIZE);
for (i=0; i<sizeof(int); i++) *(to_integer+i) = acu_scratch[i];
fe_des_length = (plural int) integer;
fe_des_index = (plural int) sizeof(int);
}
if (fe_des_index < fe_des_length) {
if (fe_des_index % SCRATCH_MEMORY_SIZE == 0) {
if (copyIn(fe_des, acu_scratch, SCRATCH_MEMORY_SIZE) != 0) {
DBG_FAIL(fprintf(dbg,"FAIL: Error loading segment %d",
fe_des_index/SCRATCH_MEMORY_SIZE));
fe_des_length = fe_des_index;
scratch[fe_des_index] = NULL;
}
sp_memcpy((plural char *plural)scratch,acu_scratch,SCRATCH_MEMORY_SIZE);
fe_des = fe_des + SCRATCH_MEMORY_SIZE;
}
return scratch[(fe_des_index++)%SCRATCH_MEMORY_SIZE];
}
else {
DBG_FAIL(fprintf(dbg,"FAIL: Requested more description than there is"));
return (plural char) 0;
}
DBG_EXIT(fprintf(dbg,"????"));
return scratch[(fe_des_index++)%SCRATCH_MEMORY_SIZE];
}
/*----------------------------------------------------------------------------*
* Function : fe_decode
*
* Parameters : MPPH_result: Handle on where we put the new thing in
* heap
* char *description: If not null, the address of a
* description buffer on the front end
*
* Description: Builds a new structure as described in the scratch buffer
* If no address for the description is given then the
* message is assumed to be in the scratch memory already,
* if next_byte will read in the next segment if needed.
* By pre-initialising the global state variables of this
* function, this code can be used to decode objects encoded
* by the back-end encode function (see above). encode
* qurantees the description to fit so that no paging is
* required (albeit discarding data in the process)
*
* Result : int: FAIL/SUCCESS
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int fe_decode( MP_PluralHeap MPPH_result, char *description )
#else
int fe_decode( MPPH_result, description )
MP_PluralHeap MPPH_result;
char *description;
#endif
{
int i;
int result_status;
plural int type;
plural int size;
plural natural tmp = NIL;
MP_PluralHeap MPPH_tmp = &tmp;
plural natural *plural general_vector;
DBG_CALL("fe_decode");
DBG_ARGS(fprintf(dbg,"MPPH_result = ????"));
type = (plural int) next_byte(description);
description = (char *) NULL;
if (type == NULL) {
OA_offsets(MPPH_result) = NIL;
}
else if (type == MP_SPECIAL) {
OA_offsets(MPPH_result) = next_byte(description);
}
else {
if (type == MP_VECTOR) size = (plural int) next_byte(0);
else size = 1;
if ((result_status = mp_alloc(type, size, MPPH_result)) != FAIL) {
switch (type) {
case MP_CONS :
size = 2;
case MP_VECTOR :
general_vector = (plural natural *plural) OA_data(MPPH_result);
for ( i=0; i<size; i++ ) general_vector[i] = NIL;
for ( i=0; i<size; i++ ) {
tmp = general_vector[i];
fe_decode( MPPH_tmp, 0 );
*(general_vector + i) = tmp;
}
break;
case INTEGER :
case MP_FLOAT :
case MP_SYMBOL:
for( i=0; i<sizeof(int); i++)
*(OA_data(MPPH_result)+i) = next_byte(0);
break;
}
}
}
if (result_status == FAIL) {
DBG_EXIT(fprintf(dbg,"FAIL: Unable to allocate space to build objects"));
return FAIL;
}
DBG_EXIT(fprintf(dbg,"SUCCESS: As far as we can tell"));
return SUCCESS;
}
/*----------------------------------------------------------------------------*
* Function : decode
*
* Parameters : MP_PluralHeap MPPH_result: Handle on heap loaction of
* resulting objects
*
* Description: Creates objects on active processors using description in
* the scratch space. This is the sister function to decode.
*
* Result : int: FAIL/SUCCESS
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int decode( MP_PluralHeap MPPH_result )
#else
int decode( MPPH_result )
MP_PluralHeap MPPH_result;
#endif
{
int i;
plural char *plural to_des_length = (plural char *plural) &fe_des_length;
DBG_CALL("decode");
DBG_ARGS(fprintf(dbg,"MPPH_result=????"));
fe_des_length = (plural int) scratch[0];
fe_des_index = (plural int) 1;
if (fe_decode(MPPH_result, NULL) == FAIL) {
DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space??"));
return FAIL;
}
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}